home *** CD-ROM | disk | FTP | other *** search
/ SPACE 2 / SPACE - Library 2 - Volume 1.iso / demos / 108 / modula / testclip.mod < prev    next >
Encoding:
Text File  |  1987-02-20  |  2.6 KB  |  95 lines
  1. MODULE testClip;
  2.  
  3. (* Jefferson Software Copyright 1986 *)
  4.  
  5. (* Jefferson Software      *)
  6. (* 12416 N 28th Dr #18-236 *)
  7. (* Phoenix,  AZ 85029-2434 *)
  8. (* (602)243-3106           *)
  9.  
  10. (* Phase BBS (602)849-1287 (up to 2400 baud) has source *)
  11. (* and answers about Jefferson Software Modula in Sig 8 *)
  12.  
  13. (* Compuserve ID 73637, 1245 *)
  14.  
  15. (* Permission to use this source is given to all who   *)
  16. (* agree to include Jefferson Software's copyright     *)
  17. (* notice, address, and phone number in all copies of  *)
  18. (* this source or source derived from this source.     *)
  19. (* Please send any changes, updates or bugs to us at   *)
  20. (* Jefferson Software. If you have code you want to    *)
  21. (* share with us all, send it and any documentation to *)
  22. (* us. Please tell us if you want your name included.  *)
  23.  
  24. FROM SYSTEM IMPORT ADR;
  25.  
  26. FROM Terminal IMPORT Read, Write, WriteLn, WriteString;
  27.  
  28. FROM ClipBoard IMPORT PClipInfo,
  29.   InfoClip, LoadClip, PutClip, UnloadClip;
  30.  
  31. TYPE Code = (info, load, put, unload);
  32.  
  33. VAR Info : PClipInfo;
  34.   buf : ARRAY [0..124] OF CHAR;
  35.   ch : CHAR;
  36.  
  37. PROCEDURE Error(code : Code);
  38. BEGIN
  39.   WriteLn;
  40.   CASE code OF
  41.     info: WriteString('InfoClip error');
  42.   | load: WriteString('LoadClip error');
  43.   | put: WriteString('PutClip error');
  44.   | unload: WriteString('Unloadclip error');
  45.   END;
  46.   WriteLn;
  47. END Error;
  48.  
  49. PROCEDURE WriteLong(x : LONGINT);
  50. VAR a, k : CARDINAL; dig : ARRAY [0..7] OF CARDINAL;
  51.   n : RECORD
  52.     CASE :CARDINAL OF
  53.       0: d : LONGINT
  54.     | 1: h, l : CARDINAL
  55.     END
  56.   END;
  57. BEGIN
  58.   n.d := x;
  59.   FOR k := 0 TO 3 DO dig[k] := n.l MOD 16; n.l := n.l DIV 16 END;
  60.   FOR k := 0 TO 3 DO dig[k+4] := n.h MOD 16; n.h := n.h DIV 16 END;
  61.   FOR k := 7 TO 0 BY -1 DO 
  62.     a := dig[k]; IF a > 9 THEN a := a + 7 END; Write(CHR(a + 30H));
  63.   END;
  64. END WriteLong;
  65.  
  66. BEGIN
  67.   WriteLn;
  68.   WriteString('Test of the Clipboard library');
  69.   IF InfoClip(Info) = 0 THEN Error(info);
  70.   ELSE
  71.     WriteLn;
  72.     IF Info^.where = 0 THEN  WriteString('not '); END;
  73.     WriteString('in memory');
  74.     WriteLn;
  75.     IF Info^.dirty = 0 THEN  WriteString('not '); END;
  76.     WriteString('"dirty"');
  77.     WriteLn;
  78.     WriteString(Info^.filename);
  79.     WriteLn;
  80.     WriteString('size '); WriteLong(Info^.size); Write('H');
  81.     WriteLn;
  82.     WriteString('at '); WriteLong(VAL(LONGINT,Info^.location)); Write('H');
  83.  
  84.     IF (Info^.where = 0) AND (LoadClip() # 0) THEN Error(load);
  85.     ELSE 
  86.       buf := '** Jefferson Software ** ';
  87.       IF PutClip(25D , ADR(buf)) # 0 THEN Error(put);
  88.       ELSE 
  89.         IF UnloadClip() # 0 THEN Error(unload) END;
  90.       END;
  91.     END;
  92.   END;
  93.   Read(ch);
  94. END testClip.
  95.